install.packages("openxlsx")
trying URL 'https://cran.rstudio.com/bin/macosx/big-sur-x86_64/contrib/4.4/openxlsx_4.2.7.1.tgz'
Content type 'application/x-gzip' length 3348577 bytes (3.2 MB)
==================================================
downloaded 3.2 MB
The downloaded binary packages are in
/var/folders/q7/82r_8nhs24sb_y_92qfw5sdw0000gn/T//Rtmp3TI802/downloaded_packages
# Instalar el paquete si no está instalado
if (!require("dplyr")) install.packages("dplyr")
Loading required package: dplyr
Attaching package: ‘dplyr’
The following objects are masked from ‘package:stats’:
filter, lag
The following objects are masked from ‘package:base’:
intersect, setdiff, setequal, union
# Cargar el paquete
library(dplyr)
.
library(openxlsx)
delitos <- read.xlsx("/Users/bquinonez/Downloads/delitos_2023.xlsx")
delitos
summary(delitos)
id-sum anio mes dia fecha franja
Min. : 1 Min. :2023 Length:157461 Length:157461 Min. :44927 Min. : 0.00
1st Qu.: 39366 1st Qu.:2023 Class :character Class :character 1st Qu.:45021 1st Qu.: 8.00
Median : 78731 Median :2023 Mode :character Mode :character Median :45113 Median :13.00
Mean : 78731 Mean :2023 Mean :45112 Mean :12.95
3rd Qu.:118096 3rd Qu.:2023 3rd Qu.:45204 3rd Qu.:18.00
Max. :157461 Max. :2023 Max. :45291 Max. :23.00
tipo subtipo uso_arma uso_moto barrio
Length:157461 Length:157461 Length:157461 Length:157461 Length:157461
Class :character Class :character Class :character Class :character Class :character
Mode :character Mode :character Mode :character Mode :character Mode :character
comuna latitud longitud cantidad
Length:157461 Length:157461 Length:157461 Min. :1
Class :character Class :character Class :character 1st Qu.:1
Mode :character Mode :character Mode :character Median :1
Mean :1
3rd Qu.:1
Max. :1
dim(delitos)
[1] 157461 15
El dataset antes del preprocesamiento cuenta con 15 columnas y 157.461 registros correspondientes al año 2023.
colSums(is.na(delitos))
id-sum anio mes dia fecha franja tipo subtipo uso_arma uso_moto barrio
0 0 0 0 0 0 0 0 0 0 35
comuna latitud longitud cantidad
0 9 9 0
Tipos de Delitos
cantidad_valores_unicos <- (unique(delitos$tipo))
print(cantidad_valores_unicos)
[1] "Vialidad" "Lesiones" "Amenazas" "Hurto" "Robo" "Homicidios"
Subtipos de delitos
conteo_por_tipo <- table(delitos$tipo)
print(conteo_por_tipo)
Amenazas Homicidios Hurto Lesiones Robo Vialidad
8332 91 62567 11045 64983 10443
cantidad_valores_unicos <- (unique(delitos$subtipo))
print(cantidad_valores_unicos)
[1] "Muertes por siniestros viales" "Lesiones por siniestros viales" "Lesiones Dolosas"
[4] "Amenazas" "Hurto total" "Robo total"
[7] "Hurto automotor" "Robo automotor" "Homicidio Doloso"
conteo_por_subtipo <- table(delitos$subtipo)
print(conteo_por_subtipo)
Amenazas Homicidio Doloso Hurto automotor
8332 91 4494
Hurto total Lesiones Dolosas Lesiones por siniestros viales
58073 11045 10339
Muertes por siniestros viales Robo automotor Robo total
104 904 64079
Agregamos la columna de franja horaria
library(dplyr)
#Genero la columna franja(horaria)
delitos <- delitos %>%
mutate(
franja_horaria = case_when(
franja >= 6 & franja < 12 ~ "Mañana",
franja >= 12 & franja < 18 ~ "Tarde",
franja >= 18 & franja < 24 ~ "Noche",
franja >= 0 & franja < 6 ~ "Madrugada",
TRUE ~ "Desconocido" # Para casos fuera de rango
)
)
delitos
Agregamos una columna que indica si es fin de semana o día de semana
delitos$tipo_dia <- ifelse(delitos$dia %in% c("SAB", "DOM"),
"Fin de semana", "Día de semana")
delitos
Agregamos una columna que indica la estación del año
# Crear columna 'estacion' basada en el mes
delitos <- delitos %>%
mutate(
estacion = case_when(
mes %in% c("diciembre", "enero", "febrero") ~ "Verano",
mes %in% c("marzo", "abril", "mayo") ~ "Otoño",
mes %in% c("junio", "julio", "agosto") ~ "Invierno",
mes %in% c("septiembre", "octubre", "noviembre") ~ "Primavera",
TRUE ~ "Desconocido" # Para casos no esperados
)
)
delitos
Conversión de longitud y latitud
# Convertir longitud y latitud a numéricas y escalarlas correctamente
delitos <- delitos %>%
mutate(
longitud = as.numeric(longitud) / 1e6, # Escalar dividiendo entre 10^6
latitud = as.numeric(latitud) / 1e6 # Escalar dividiendo entre 10^6
)
Warning: There were 2 warnings in `mutate()`.
The first warning was:
ℹ In argument: `longitud = as.numeric(longitud)/1e+06`.
Caused by warning:
! NAs introduced by coercion
ℹ Run ]8;;ide:run:dplyr::last_dplyr_warnings()dplyr::last_dplyr_warnings()]8;; to see the 1 remaining warning.
# Verificar las primeras filas para confirmar
head(delitos[c("longitud", "latitud")])
Eliminación de nulos y barrios que no forman parte de CABA
library(stringr)
delitos <- na.omit(delitos)
dim(delitos)
[1] 154521 18
delitos <- delitos %>%
filter(barrio != "0", barrio != "Sin geo", barrio != "NULL", barrio != "NO ESPECIFICADA", barrio != "GREGORIO DE LAFERRERE") %>%
mutate(barrio = str_replace_all(barrio, "NUNEZ", "NUÑEZ"))
Armamos la agrupación por barrio y fecha y creamos la matriz funcinal con barrios como filas y fechas como columnas
# Cargar librerías necesarias
if (!require("RColorBrewer")) install.packages("RColorBrewer")
Loading required package: RColorBrewer
library(RColorBrewer)
library(dplyr)
library(tidyr)
library(fda.usc)
Loading required package: fda
Loading required package: splines
Loading required package: fds
Loading required package: rainbow
Loading required package: MASS
Attaching package: ‘MASS’
The following object is masked from ‘package:dplyr’:
select
Loading required package: pcaPP
Loading required package: RCurl
Attaching package: ‘RCurl’
The following object is masked from ‘package:tidyr’:
complete
Loading required package: deSolve
Attaching package: ‘fda’
The following object is masked from ‘package:graphics’:
matplot
Loading required package: mgcv
Loading required package: nlme
Attaching package: ‘nlme’
The following object is masked from ‘package:dplyr’:
collapse
The following object is masked from ‘package:rrcov’:
getData
This is mgcv 1.9-1. For overview type 'help("mgcv-package")'.
Loading required package: knitr
fda.usc is running sequentially usign foreach package
Please, execute ops.fda.usc() once to run in local parallel mode
Deprecated functions: min.basis, min.np, anova.hetero, anova.onefactor, anova.RPm
New functions: optim.basis, optim.np, fanova.hetero, fanova.onefactor, fanova.RPm
----------------------------------------------------------------------------------
library(fda)
library(ggplot2)
library(ggrepel)
library(tibble) # Para usar column_to_rownames
# Paso 1: Agrupar datos y preparar la matriz funcional
# Agrupar por barrio y fecha, sumando la frecuencia de delitos
delitos_agrupados_barrio <- delitos %>%
group_by(barrio, fecha) %>%
summarise(frecuencia_diaria = sum(cantidad, na.rm = TRUE), .groups = "drop")
# Crear matriz funcional: barrios como filas, fechas como columnas
delitos_matrix <- delitos_agrupados_barrio %>%
pivot_wider(names_from = fecha, values_from = frecuencia_diaria, values_fill = 0) %>%
column_to_rownames(var = "barrio") %>%
as.matrix()
# Eliminar filas con valores faltantes y verificar la variabilidad
delitos_matrix <- delitos_matrix[complete.cases(delitos_matrix), ]
variabilidad <- apply(delitos_matrix, 1, var, na.rm = TRUE)
delitos_matrix <- delitos_matrix[variabilidad > 0.01, ]
# Crear un vector de fechas reales
fechas_date <- seq.Date(from = as.Date("2023-01-01"), by = "day", length.out = ncol(delitos_matrix))
# Graficar curvas originales por barrio sin aplicar FDA
# Crear el gráfico con dimensiones ampliadas
png("grafico_sin_fda.png", width = 2000, height = 1200, res = 150) # Resolución más alta
# Ajustar márgenes: más espacio izquierdo para la leyenda
par(mar = c(10, 35, 4, 4) + 0.1) # Aumentar margen izquierdo
# Crear colores únicos para cada barrio
colores <- rainbow(nrow(delitos_matrix))
# Graficar las curvas originales
matplot(fechas_date, t(delitos_matrix), type = "l", lty = 1, col = colores, lwd = 2,
xlab = "Fecha", ylab = "Frecuencia", xaxt = "n",
main = "Curvas por Barrio (Sin suavizado)")
NULL
# Crear etiquetas de fechas en el eje X
fechas_etiquetas <- seq(min(fechas_date), max(fechas_date), by = "2 weeks") # Mostrar cada dos semanas
axis(1,
at = as.numeric(fechas_etiquetas), # Usar fechas reales como índices
labels = format(fechas_etiquetas, "%d %b"), # Día y mes
las = 2, # Rotar las etiquetas
cex.axis = 0.8) # Tamaño del texto en el eje Xpe
# Crear una leyenda más amplia en el margen izquierdo
legend("topright",
inset = c(1.2, 0), # Más espacio hacia la izquierda
rownames(delitos_matrix),
col = colores,
lty = 1,
lwd = 4, # Grosor de las líneas
ncol = 2, # Dividir la leyenda en dos columnas
cex = 0.9, # Tamaño del texto más grande
xpd = TRUE) # Permitir que la leyenda esté fuera del área de dibujo
# Guardar y cerrar el archivo PNG
dev.off()
null device
1
# Verificar que el archivo fue creado
browseURL("grafico_sin_fda.png")
dim(delitos_matrix) # Deberías ver (n_barrio, n_fechas)
[1] 48 365
delitos_matrix_normalized <- scale(delitos_matrix)
library(factoextra)
Welcome! Want to learn more? See two factoextra-related books at https://goo.gl/ve3WBa
# Método del codo para determinar el número óptimo de clusters
fviz_nbclust(delitos_matrix_normalized, kmeans, method = "wss") +
labs(title = "Método del Codo")
fviz_nbclust(delitos_matrix_normalized, kmeans, method = "silhouette") +
labs(title = "Índice de Silhouette")
Aplicamos los clusters
set.seed(123) # Para reproducibilidad
num_clusters <- 2 # Cambia según los resultados del método del codo o Silhouette
kmeans_result <- kmeans(delitos_matrix_normalized, centers = num_clusters, nstart = 20)
clusters <- data.frame(
barrio = rownames(delitos_matrix),
cluster = kmeans_result$cluster
)
# Ordenar el dataframe por cluster
clusters_ordenados <- clusters %>%
arrange(cluster)
# Ver los primeros resultados
print(clusters_ordenados)
NA
NA
Usamos PCA para graficar los clusters
library(ggplot2)
library(dplyr)
# Calcular la cantidad de barrios por cluster
cluster_sizes <- clusters %>%
group_by(cluster) %>%
summarise(n_barrios = n()) %>%
mutate(cluster_label = paste0("Cluster ", cluster, " (n=", n_barrios, ")"))
# Convertir `cluster` a character o factor en ambos dataframes
pca_data <- as.data.frame(pca_result$x[, 1:2]) # Tomar las dos primeras componentes
pca_data$cluster <- as.factor(clusters$cluster) # Convertir a factor
cluster_sizes$cluster <- as.factor(cluster_sizes$cluster) # Convertir a factor
# Combinar con las etiquetas personalizadas
pca_data <- pca_data %>%
left_join(cluster_sizes, by = "cluster")
# Graficar PCA con leyenda personalizada
ggplot(pca_data, aes(x = PC1, y = PC2, color = cluster_label)) +
geom_point(size = 3, alpha = 0.7) + # Puntos para los barrios
theme_minimal() +
labs(
title = "Clusters Visualizados en el Espacio PCA",
x = "PC1",
y = "PC2",
color = "Cluster"
) +
theme(legend.position = "bottom")
NA
NA
delitos_df <- as.data.frame(delitos_matrix) %>%
rownames_to_column(var = "barrio") # Convertir rownames en columna llamada 'barrio'
resumen_clusters <- clusters %>%
left_join(delitos_df, by = "barrio") %>% # 'barrio' ya es una columna explícita
group_by(cluster) %>%
summarise_all(mean, na.rm = TRUE)
Warning: There were 2 warnings in `summarise()`.
The first warning was:
ℹ In argument: `barrio = (function (x, ...) ...`.
ℹ In group 1: `cluster = 1`.
Caused by warning in `mean.default()`:
! argument is not numeric or logical: returning NA
ℹ Run ]8;;ide:run:dplyr::last_dplyr_warnings()dplyr::last_dplyr_warnings()]8;; to see the 1 remaining warning.
print(resumen_clusters)
NA
library(cluster)
# Calcular índice de Silhouette
silhouette_result <- silhouette(kmeans_result$cluster, dist(delitos_matrix_normalized))
# Resumen del índice de Silhouette
summary(silhouette_result)
Silhouette of 48 units in 2 clusters from silhouette.default(x = kmeans_result$cluster, dist = dist(delitos_matrix_normalized)) :
Cluster sizes and average silhouette widths:
38 10
0.6097475 0.2389282
Individual silhouette widths:
Min. 1st Qu. Median Mean 3rd Qu. Max.
-0.07585 0.40748 0.61745 0.53249 0.70691 0.72233
# Inspeccionar los valores del índice de Silhouette
head(silhouette_result[, 1:3]) # Cluster, vecino más cercano, valor de Silhouette
cluster neighbor sil_width
[1,] 1 2 0.70668284
[2,] 2 1 0.16010046
[3,] 2 1 0.42544455
[4,] 2 1 0.07900193
[5,] 2 1 -0.07585089
[6,] 1 2 0.61609869
# Promedio del índice
mean(silhouette_result[, 3])
[1] 0.5324934
# Visualizar índice de Silhouette
fviz_silhouette(silhouette_result) +
labs(title = "Índice de Silhouette por Cluster",
x = "Índice de Silhouette",
y = "Barrios")
NA
# Paso 2: Representar Datos como Curvas Funcionales con Suavizado
# Crear una base B-spline penalizada para suavizar las funciones
nbasis <- 25 # Ajusta el número de bases para mayor flexibilidad
lambda <- 1e-2 # Parámetro de suavizado; menor valor = más suave
# Crear la base B-spline
basis <- create.bspline.basis(rangeval = range(fechas_date), nbasis = nbasis)
# Definir el objeto de parámetros funcionales con suavizado
fd_par <- fdPar(basis, Lfdobj = int2Lfd(2), lambda = lambda)
# Convertir las filas de la matriz en funciones continuas suavizadas
fd_obj_suavizado <- smooth.basis(fechas_date, t(delitos_matrix), fd_par)$fd
# Visualizar las funciones suavizadas por barrio antes del clustering
colores <- rainbow(nrow(delitos_matrix)) # Generar colores únicos para cada barrio
# Crear el gráfico con dimensiones ampliadas
png("grafico_mejorado_legenda.png", width = 2000, height = 1200, res = 150) # Resolución más alta
# Ajustar márgenes: más espacio derecho para la leyenda
par(mar = c(10, 4, 4, 35) + 0.1) # Aumentar margen derecho para que la leyenda no quede cortada
# Graficar las funciones suavizadas
plot(fd_obj_suavizado, main = "Curvas por Barrio suavizadas con FDA",
xlab = "Fecha", ylab = "Frecuencia",
col = colores,
lwd = 2, xaxt = "n") # Desactivar eje X predeterminado
[1] "done"
# Crear etiquetas de fechas en el eje X
fechas_etiquetas <- seq(min(fechas_date), max(fechas_date), by = "2 weeks") # Mostrar cada dos semanas
axis(1,
at = as.numeric(fechas_etiquetas), # Usar fechas reales como índices
labels = format(fechas_etiquetas, "%d %b"), # Día y mes
las = 2, # Rotar las etiquetas
cex.axis = 0.8) # Tamaño del texto en el eje X
# Crear una leyenda ajustada en el lado derecho del gráfico
legend("topleft",
inset = c(1.1, 0), # Reducir el espacio hacia la derecha
legend = rownames(delitos_matrix),
col = colores,
lty = 1,
lwd = 4, # Grosor de las líneas
ncol = 2, # Dividir la leyenda en dos columnas
cex = 0.9, # Tamaño del texto ajustado
xpd = TRUE) # Permitir que la leyenda esté fuera del área de dibujo
# Guardar y cerrar el archivo PNG
dev.off()
null device
1
# Verificar que el archivo fue creado
browseURL("grafico_mejorado_legenda.png")
# Paso 3: Clustering Funcional con K-Means
# Determinar el número óptimo de clusters con el método del codo
set.seed(123)
wss <- sapply(2:10, function(k) {
kmeans(fd_obj_suavizado$coefs, centers = k, nstart = 20)$tot.withinss
})
# Graficar el método del codo
plot(2:10, wss, type = "b", pch = 19, frame = FALSE,
xlab = "Número de Clusters", ylab = "Suma de Errores al Cuadrado (WSS)",
main = "Método del Codo para Clustering Funcional")
# Elegir un número de clusters (por ejemplo, 3)
num_clusters <- 2
kmeans_result <- kmeans(fd_obj_suavizado$coefs, centers = num_clusters, nstart = 20)
fviz_nbclust(fd_obj_suavizado$coefs, kmeans, method = "silhouette") +
labs(title = "Índice de Silhouette")
fd_transposed <- t(fd_obj_suavizado$coefs)
# Aplicar kmeans funcional con manejo de clusters pequeños
num_clusters <- 2 # Cambiar según necesidad
# Aplicar clustering funcional
kmeans_result <- kmeans(t(fd_obj_suavizado$coefs), centers = num_clusters, nstart = 20)
# Asignar clusters a los barrios
# Crear el dataframe con los barrios y los clusters asignados
clusters <- data.frame(
barrio = colnames(fd_obj_suavizado$coefs), # Nombres de los barrios
cluster = kmeans_result$cluster # Clusters asignados
)
# Evaluar las curvas funcionales
matriz_evaluada <- t(eval.fd(fechas_date, fd_obj_suavizado)) # Evaluar en fechas_date
# Asignar las fechas como nombres de las columnas
colnames(matriz_evaluada) <- as.character(fechas_date) # Convertir fechas a texto
# Actualizar etiquetas de los clusters con los tamaños
df_curves <- as.data.frame(matriz_evaluada) %>%
rownames_to_column("barrio") %>%
pivot_longer(-barrio, names_to = "fecha", values_to = "frecuencia") %>%
mutate(
fecha = as.Date(fecha), # Convertir texto a objeto Date
cluster = factor(clusters$cluster[match(barrio, clusters$barrio)])
)
# Calcular cantidad de barrios únicos por cluster
cluster_sizes <- df_curves %>%
group_by(cluster) %>%
summarise(n_barrios = n_distinct(barrio)) # Contar barrios únicos
df_curves <- df_curves %>%
left_join(cluster_sizes, by = "cluster") %>% # Agregar tamaños al dataframe
mutate(cluster_label = paste0("Cluster ", cluster, " (n=", n_barrios, ")")) # Etiquetas personalizadas
ggplot(df_curves, aes(x = fecha, y = frecuencia, group = barrio, color = cluster_label)) +
geom_line(alpha = 0.7) +
theme_minimal() +
labs(
title = "Clustering Funcional por Barrio",
x = "Fecha",
y = "Frecuencia",
color = "Cluster"
) +
theme(legend.position = "bottom")
# Crear la tabla con los barrios por cluster
tabla_barrios <- df_curves %>%
dplyr::select(barrio, cluster_label) %>% # Seleccionar columnas necesarias
distinct() %>% # Eliminar duplicados
arrange(cluster_label, barrio) # Ordenar por cluster y barrio
print(tabla_barrios)
NA
# Calcular la frecuencia promedio por cluster y fecha
df_avg <- df_curves %>%
group_by(cluster_label, fecha) %>%
summarise(frecuencia_promedio = mean(frecuencia), .groups = "drop")
ggplot() +
# Curvas individuales
geom_line(data = df_curves, aes(x = fecha, y = frecuencia, group = barrio, color = cluster_label), alpha = 0.4) +
# Curvas promedio por cluster
geom_line(data = df_avg, aes(x = fecha, y = frecuencia_promedio, group = cluster_label, color = cluster_label), size = 1.5) +
theme_minimal() +
labs(
title = "Clustering Funcional por Barrio con Curvas Promedio",
x = "Fecha",
y = "Frecuencia",
color = "Cluster"
) +
theme(legend.position = "bottom")
Warning: Using `size` aesthetic for lines was deprecated in ggplot2 3.4.0.
Please use `linewidth` instead.
if (!require("cluster")) install.packages("cluster")
if (!require("factoextra")) install.packages("factoextra")
library(cluster)
library(factoextra)
# Asegurar que los clusters coinciden con la matriz
clusters <- df_curves %>%
distinct(barrio, cluster) %>%
arrange(barrio) # Ordenar por barrio para garantizar coincidencia
matriz_clustering <- matriz_clustering[order(rownames(matriz_clustering)), ] # Ordenar filas por nombre de barrio
# Calcular el índice de Silhouette
silhouette_result <- silhouette(as.numeric(clusters$cluster), dist(matriz_clustering))
Warning: NAs introduced by coercion
# Resumen del índice de Silhouette
summary(silhouette_result)
Silhouette of 48 units in 2 clusters from silhouette.default(x = as.numeric(clusters$cluster), dist = dist(matriz_clustering)) :
Cluster sizes and average silhouette widths:
38 10
0.6933336 0.3951933
Individual silhouette widths:
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.05452 0.51765 0.74675 0.63122 0.77368 0.79867
# Inspeccionar los valores del índice de Silhouette
head(silhouette_result[, 1:3]) # Cluster, vecino más cercano, valor de Silhouette
cluster neighbor sil_width
[1,] 1 2 0.74779439
[2,] 2 1 0.35756135
[3,] 2 1 0.52688158
[4,] 2 1 0.24524335
[5,] 2 1 0.05451973
[6,] 1 2 0.73760567
# Promedio del índice
mean(silhouette_result[, 3])
[1] 0.631221
# Visualizar Silhouette
fviz_silhouette(silhouette_result) +
labs(title = "Índice de Silhouette por Cluster",
x = "Índice de Silhouette",
y = "Barrios") +
theme_minimal()
NA
NA
# Paso 2: Extraer los coeficientes funcionales
coeficientes <- t(fd_obj_suavizado$coefs)
# Paso 3: Aplicar PCA a los coeficientes funcionales
pca_result <- prcomp(coeficientes, center = TRUE, scale. = TRUE) # Normalizar para PCA
# Explorar la varianza explicada por las componentes principales
varianza_explicada <- cumsum(pca_result$sdev^2) / sum(pca_result$sdev^2) * 100
print(varianza_explicada) # Ver proporción de varianza explicada
[1] 87.95647 91.38211 93.35515 94.71343 95.90995 96.62760 97.19225 97.62889 98.04136 98.42655
[11] 98.74606 98.99938 99.19263 99.34640 99.49113 99.61475 99.71369 99.78494 99.84267 99.88468
[21] 99.92142 99.94973 99.96856 99.98455 100.00000
# Elegir el número de componentes principales
num_componentes <- 2 # Cambiar según necesidad (e.g., varianza explicada > 80%)
scores_pca <- pca_result$x[, 1:num_componentes] # Tomar los scores de las componentes seleccionadas
# Paso 4: Aplicar k-means usando los scores de PCA
set.seed(123) # Para reproducibilidad
num_clusters <- 2 # Cambiar según necesidad
kmeans_result <- kmeans(scores_pca, centers = num_clusters, nstart = 20)
# Ver los clusters asignados
clusters <- data.frame(
barrio = colnames(fd_obj_suavizado$coefs),
cluster = kmeans_result$cluster
)
# Ordenar el dataframe por cluster
clusters_ordenados <- clusters %>%
arrange(cluster)
# Ver los primeros resultados
print(clusters_ordenados)
library(ggplot2)
# Crear un dataframe con las dos primeras componentes principales y los clusters
df_pca <- as.data.frame(scores_pca) # Convertir los scores seleccionados a dataframe
df_pca$cluster <- as.factor(kmeans_result$cluster) # Agregar los clusters asignados
df_pca$barrio <- colnames(fd_obj_suavizado$coefs) # Agregar nombres de los barrios
library(ggplot2)
library(dplyr)
# Calcular la cantidad de barrios por cluster
cluster_sizes <- df_pca %>%
group_by(cluster) %>%
summarise(n_barrios = n()) # Contar barrios por cluster
# Crear etiquetas personalizadas para la leyenda
cluster_labels <- cluster_sizes %>%
mutate(cluster_label = paste0("Cluster ", cluster, " (n=", n_barrios, ")")) %>%
pull(cluster_label) # Extraer etiquetas como vector
# Mapear las etiquetas a los clusters
names(cluster_labels) <- cluster_sizes$cluster # Asignar etiquetas por número de cluster
# Graficar los clusters en el espacio PCA con las etiquetas personalizadas
ggplot(df_pca, aes(x = PC1, y = PC2, color = cluster)) +
geom_point(size = 3, alpha = 0.7) + # Representar los puntos
theme_minimal() +
labs(
title = "Clusters Visualizados en el Espacio PCA",
x = "Componente Principal 1",
y = "Componente Principal 2",
color = "Cluster"
) +
theme(legend.position = "bottom") +
scale_color_manual(
values = c("#1b9e77", "#d95f02", "#7570b3", "#e7298a"), # Colores personalizados
labels = cluster_labels # Etiquetas con la cantidad de barrios
)
NA
NA
library(cluster)
library(factoextra)
# Calcular la matriz de distancias usando los scores PCA
dist_pca <- dist(df_pca[, c("PC1", "PC2")])
# Calcular el índice de Silhouette
silhouette_result <- silhouette(as.numeric(df_pca$cluster), dist_pca)
# Ver un resumen del índice de Silhouette
summary(silhouette_result)
Silhouette of 48 units in 2 clusters from silhouette.default(x = as.numeric(df_pca$cluster), dist = dist_pca) :
Cluster sizes and average silhouette widths:
38 10
0.6837485 0.4056394
Individual silhouette widths:
Min. 1st Qu. Median Mean 3rd Qu. Max.
0.02632 0.53374 0.74402 0.62581 0.77813 0.79962
# Promedio del índice de Silhouette
silhouette_avg <- mean(silhouette_result[, 3])
print(paste("Índice de Silhouette promedio:", round(silhouette_avg, 3)))
[1] "Índice de Silhouette promedio: 0.626"
# Visualizar el índice de Silhouette
fviz_silhouette(silhouette_result) +
labs(
title = "Índice de Silhouette para Clusters en PCA",
x = "Índice de Silhouette",
y = "Barrios"
) +
theme_minimal()
NA
NA
NA